perm filename FRECRD.F4[KI,ALS] blob sn#094485 filedate 1974-04-02 generic text, type T, neo UTF8
00100		SUBROUTINE FRECRD(A)
00200		IMPLICIT INTEGER(A-Z)
00300		DIMENSION A(2)
00400		DATA SPEED/25600/
00500		DATA NUM/9216/
00600		CALL FIXUPA(A)
00700		TOTWRD=3*NUM
00800		PT1=1
00900		PT2=1+NUM
01000		PT3=1+NUM+NUM
01100		CALL TORITE(JFN,'LISTEN.TMP')
01200		CALL SETWRT(1,JFN)
01300		CALL STRNGO('ABOUT TO TRY TO ASSIGN ADC ')
01400		CALL SETAD(11,SPEED)
01500		CALL STRNGO(' - SUCCESSFUL')
01600		CALL LFCR
01700		NSEC=5
01800		NSAMP=25600*NSEC
01900		NWORDS=NSAMP/3
02000		TEST=NSAMP-NWORDS*3
02100		IF(TEST.GT.0)NWORDS=NWORDS+1
02200		NPAGES=NWORDS/512
02300		TEST=NWORDS-512*NPAGES
02400		IF(TEST.GT.0)NPAGES=NPAGES+1
02500		NWORDS=512*NPAGES
02600		NITER=NWORDS/(3*NUM)
02700		NLEFT=NWORDS-3*NUM*NITER
02800		FL1=0
02900		FL2=0
03000		FL3=0
03100		IF(NLEFT.GT.NUM)GO TO 1
03200		NL1=NLEFT
03300		IF(NL1.LE.0)FL1=1
03400		IF(NL1.LE.0)NL1=1
03500		NL2=1
03600		FL2=1
03700		NL3=1
03800		FL3=1
03900		GO TO 3
04000	1	CONTINUE
04100		NL1=NUM
04200		NLEFT=NLEFT-NUM
04300		IF(NLEFT.GT.NUM)GO TO 2
04400		NL2=NLEFT
04500		IF(NL2.LE.0)FL2=1
04600		IF(NL2.LE.0)NL2=1
04700		NL3=1
04800		FL3=1
04900		GO TO 3
05000	2	CONTINUE
05100		NL2=NUM
05200		NL3=NLEFT-NUM
05300		IF(NL3.LE.0)FL3=1
05400		IF(NL3.LE.0)NL3=1
05500	3	CONTINUE
     

00100		CALL STRNGO('ABOUT TO TRY TO ASSIGN XGP ')
00200		CALL SETXGP
00300		CALL STRNGO(' - SUCCESSFUL')
00400		CALL LFCR
00500		CALL GCORE(TOTWRD)
00600		CALL LOCK
00700		IF(NITER.GT.0)GO TO 4
00800		CALL ADINP1(NL1,A(PT1))
00900		CALL ADINP2(NL2,A(PT2))
01000		CALL ADINP3(NL3,A(PT3))
01100		GO TO 7
01200	4	CONTINUE
01300		CALL ADINP1(NUM,A(PT1))
01400		CALL ADINP2(NUM,A(PT2))
01500		CALL ADINP3(NUM,A(PT3))
01600		IF(NITER.LE.1)GO TO 6
01700		DO 5 LLL=2,NITER
01800		CALL FSTOUT(NUM,A(PT1))
01900		CALL ADINP1(NUM,A(PT1))
02000		CALL FSTOUT(NUM,A(PT2))
02100		CALL ADINP2(NUM,A(PT2))
02200		CALL FSTOUT(NUM,A(PT3))
02300		CALL ADINP3(NUM,A(PT3))
02400	5	CONTINUE
02500	6	CONTINUE
02600		CALL FSTOUT(NUM,A(PT1))
02700		CALL ADINP1(NL1,A(PT1))
02800		CALL FSTOUT(NUM,A(PT2))
02900		CALL ADINP2(NL2,A(PT2))
03000		CALL FSTOUT(NUM,A(PT3))
03100		CALL ADINP3(NL3,A(PT3))
03200	7	CONTINUE
03300		IF(FL1.LE.0)CALL FSTOUT(NL1,A(PT1))
03400		CALL ADINP1(1,A(PT1))
03500		IF(FL2.LE.0)CALL FSTOUT(NL2,A(PT2))
03600		CALL ADINP2(1,A(PT2))
03700		IF(FL3.LE.0)CALL FSTOUT(NL3,A(PT3))
03800		CALL UNLOCK
03900		CALL RELXGP
04000		CALL STRNGO('XGP RELEASED')
04100		CALL LFCR
04200		CALL RELAD
04300		CALL STRNGO('ADC RELEASED')
04400		CALL LFCR
04500		CALL SCLOSE(JFN)
04600		RETURN
04700		END